home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / stsim2.zip / MENU.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-01  |  2KB  |  99 lines
  1. unit menu;
  2.  
  3. interface
  4. function menu1(x,y:integer;work_string:string):string;
  5. { work_string =
  6.     'opt1.opt2.opt3'
  7. }
  8. procedure box(x,y,xx,yy:integer);
  9.  
  10. implementation
  11. uses crt;
  12.  
  13. procedure box(x,y,xx,yy:integer);
  14. var i:integer;
  15. begin
  16.     gotoxy(x,yy);write(chr(200));
  17.     gotoxy(x,y);write(chr(201));
  18.     gotoxy(xx,y);write(chr(187));
  19.     gotoxy(xx,yy);write(chr(188));
  20.     for i:=(x+1) to (xx-1) do begin
  21.         gotoxy(i,y);
  22.         write(chr(205));
  23.         gotoxy(i,yy);
  24.         write(chr(205));
  25.     end;
  26.  
  27.     for i:=(y+1) to (yy-1) do begin
  28.         gotoxy(x,i);
  29.         write(chr(186));
  30.         gotoxy(xx,i);
  31.         write(chr(186));
  32.     end;
  33. end;
  34.  
  35. function menu1(x,y:integer;work_string:string):string;
  36. var
  37.     choices:array[1..20] of string;
  38.     i,ii:integer;
  39.     pos_mark,num_choices,
  40.     longest_one:integer;
  41.     tmp_attr:integer;
  42. begin
  43.     tmp_attr:=textattr;
  44.     textattr:=7;
  45.     ii:=1;
  46.     choices[ii]:='';
  47.     for i:=1 to length(work_string) do
  48.         if work_string[i]<>',' then
  49.             choices[ii]:=choices[ii]+work_string[i]
  50.         else begin
  51.             inc(ii);
  52.             choices[ii]:='';
  53.         end;
  54.     inc(ii);
  55.     choices[ii]:='';
  56.  
  57.     num_choices:=ii-1;
  58.     longest_one:=0;
  59.     for i:=1 to num_choices do
  60.         if length(choices[i])>longest_one then
  61.             longest_one:=length(choices[i]);
  62.  
  63.     box(x,y, x+longest_one+1, y+num_choices+1);
  64.     for i:=1 to num_choices do begin
  65.         gotoxy(x+1,y+i);
  66.         write(choices[i]);
  67.     end;
  68.  
  69.     {---------------------------}
  70.     pos_mark:=1;
  71.     gotoxy(x+1,y+pos_mark);
  72.     textattr:=120;
  73.     write(choices[pos_mark]);
  74.  
  75.     repeat
  76.       i:=pos_mark;
  77.  
  78.       if ord(readkey)=13 then begin
  79.                 menu1:=choices[pos_mark];
  80.                 textattr:=tmp_attr;
  81.                 exit;
  82.              end else
  83.  
  84.       case readkey of
  85.         'H':if pos_mark>1 then dec(pos_mark);
  86.         'P':if pos_mark<num_choices then inc(pos_mark);
  87.       end;
  88.  
  89.       gotoxy(x+1,y+i);
  90.       textattr:=7;
  91.       write(choices[i]);
  92.  
  93.       gotoxy(x+1,y+pos_mark);
  94.       textattr:=120;
  95.       write(choices[pos_mark]);
  96.     until false;
  97. end;
  98.  
  99. end.